Read mortality data
ACM_5_with_networks <-
read_excel("data/mortality/ACM-5%-networks-overlap-correction-TP-SW.xlsx",
sheet = "data-ACM")
studyTable <- ACM_5_with_networks %>%
filter(!is.na(effect)) %>%
mutate(sef = ifelse(is.na(se_Adj),1, se_Adj)) %>% #get Adjustments for common cohorts
mutate(var = (se*sef)^2)
Get all studies
studyIds <- unique(studyTable$id)
There are 82 studies
We now check studies for variance and effect inconsistency.
studyIds <- unique(studyTable$id)
errorstudies <- c()
warnmess <- c()
studyInconsistency <- data.frame()
studyGraphs <- lapply(studyIds, function(stid){
res <- {}
tryCatch({
stgr <- fullGraph(stid, studyTable ,rand=F)
res <- stgr
},error = function(cond){
# print(c("error in study",stid))
errorstudies <<- c(errorstudies,stid)
# message(conditionMessage(cond))
})
return(res)
})
## Warning in treatVars(gr, spt): found negative variances in study
## 44_EPIC-Italy_d the following comparisons will be ignored in order to get
## consistent variances CHO:PP
## Warning in treatVars(gr, spt): found negative variances in study 51_PREDIMED_b
## the following comparisons will be ignored in order to get consistent variances
## MUFA:SFA,PUFA:TFA,PUFA:SFA
## Warning in treatVars(gr, spt): found negative variances in study 62_UKB_b the
## following comparisons will be ignored in order to get consistent variances
## CHO:TFA,CHO:PUFA,MUFA:SFA,MUFA:PUFA,MUFA:PRO,PRO:TFA,PRO:PUFA,PUFA:TFA,SFA:TFA
## Warning in treatVars(gr, spt): found negative variances in study 62_UKB_d the
## following comparisons will be ignored in order to get consistent variances
## CHO:PP,MUFA:PP,PP:TFA,PP:SFA,PP:PUFA
## Warning in treatVars(gr, spt): found negative variances in study 62_UKB_f the
## following comparisons will be ignored in order to get consistent variances
## MUFA:n3-PUFA,n3-PUFA:TFA,n3-PUFA:SFA,n3-PUFA:PRO,n3-PUFA:n6-PUFA
## Warning in treatVars(gr, spt): found negative variances in study 159_WHI the
## following comparisons will be ignored in order to get consistent variances
## CHO:PP
## Warning in treatVars(gr, spt): found negative variances in study 196_NIH-AARP_c
## the following comparisons will be ignored in order to get consistent variances
## MUFA-A:SFA
## Warning in treatVars(gr, spt): found negative variances in study 196_NIH-AARP_f
## the following comparisons will be ignored in order to get consistent variances
## n3-PUFA:SFA
SGs <- Filter(function(g){!is.null(g)},studyGraphs)
names(SGs)<-lapply(SGs,function(x){return(x$study)}) %>% unlist()
incgs <- Filter(function(g){g$inc & g$pvalue < 0.90},SGs)
lapply(incgs, function(g){plotDiffs(g)})
## $`82_IWHS_d`
## NULL
##
## $`115_CHNS_c`
## NULL
##
## $`196_NIH-AARP_b`
## NULL
##
## $`196_NIH-AARP_c`
## NULL
For each network, the network plot and the forest plots of logRRs
using the random effects model are shown. All results and plots are in
the results directory. The R objects are saved as
.rds files
report <- lapply(1:7,function(netid){
print(paste("Network ", netid, sep=""))
pairwiseReport(studyTable, SGs, netid, "mortality")
netReport(studyTable, SGs, netid, "mortality")
})
## [1] "Network 1"
## [1] "Network 2"
## [1] "Network 3"
## [1] "Network 4"
## [1] "Network 5"
## [1] "Network 6"
## [1] "Network 7"
report <- lapply(1:7,function(netid){
print(paste("Network ", netid, sep=""))
netReport(studyTable, SGs, netid, "mortality", subgroup="RoB_subg")
})
## [1] "Network 1"
## [1] "Subgroup" "high"
## Warning in FUN(X[[i]], ...): less than 10 studies in group
## [1] "Subgroup" "some concerns"
## [1] "Network 2"
## [1] "Subgroup" "high"
## [1] "Subgroup" "some concerns"
## [1] "Network 3"
## [1] "Subgroup" "high"
## Warning in FUN(X[[i]], ...): less than 10 studies in group
## [1] "Subgroup" "some concerns"
## Warning in FUN(X[[i]], ...): less than 10 studies in group
## [1] "Network 4"
## [1] "Subgroup" "high"
## Warning in FUN(X[[i]], ...): less than 10 studies in group
## [1] "Subgroup" "some concerns"
## [1] "Network 5"
## [1] "Subgroup" "high"
## Warning in FUN(X[[i]], ...): less than 10 studies in group
## [1] "Subgroup" "some concerns"
## Warning in FUN(X[[i]], ...): less than 10 studies in group
## [1] "Network 6"
## [1] "Subgroup" "high"
## Warning in FUN(X[[i]], ...): less than 10 studies in group
## [1] "Subgroup" "some concerns"
## Warning in FUN(X[[i]], ...): less than 10 studies in group
## [1] "Network 7"
## [1] "Subgroup" "high"
## Warning in FUN(X[[i]], ...): less than 10 studies in group
## [1] "Subgroup" "some concerns"
## Warning in FUN(X[[i]], ...): less than 10 studies in group
report <- lapply(1:7,function(netid){
print(paste("Network ", netid, sep=""))
netReport(studyTable, SGs, netid, "mortality", subgroup="location_subg")
})
## [1] "Network 1"
## [1] "Subgroup" "europe"
## Warning in FUN(X[[i]], ...): less than 10 studies in group
## [1] "Subgroup" "asia"
## Warning in FUN(X[[i]], ...): less than 10 studies in group
## [1] "Subgroup" "australia"
## Warning in FUN(X[[i]], ...): less than 10 studies in group
## [1] "Subgroup" "mixed"
## Warning in FUN(X[[i]], ...): less than 10 studies in group
## [1] "Subgroup" "america"
## [1] "Network 2"
## [1] "Subgroup" "europe"
## Warning in FUN(X[[i]], ...): less than 10 studies in group
## [1] "Subgroup" "asia"
## Warning in FUN(X[[i]], ...): less than 10 studies in group
## [1] "Subgroup" "australia"
## Warning in FUN(X[[i]], ...): less than 10 studies in group
## [1] "Subgroup" "mixed"
## Warning in FUN(X[[i]], ...): less than 10 studies in group
## [1] "Subgroup" "america"
## Warning in FUN(X[[i]], ...): less than 10 studies in group
## [1] "Network 3"
## [1] "Subgroup" "europe"
## Warning in FUN(X[[i]], ...): less than 10 studies in group
## [1] "Subgroup" "asia"
## Warning in FUN(X[[i]], ...): less than 10 studies in group
## [1] "Subgroup" "australia"
## Warning in FUN(X[[i]], ...): less than 10 studies in group
## [1] "Subgroup" "mixed"
## Warning in FUN(X[[i]], ...): less than 10 studies in group
## [1] "Subgroup" "america"
## Warning in FUN(X[[i]], ...): less than 10 studies in group
## [1] "Network 4"
## [1] "Subgroup" "europe"
## Warning in FUN(X[[i]], ...): less than 10 studies in group
## [1] "Subgroup" "asia"
## Warning in FUN(X[[i]], ...): less than 10 studies in group
## [1] "Subgroup" "australia"
## Warning in FUN(X[[i]], ...): less than 10 studies in group
## [1] "Subgroup" "mixed"
## Warning in FUN(X[[i]], ...): less than 10 studies in group
## [1] "Subgroup" "america"
## [1] "Network 5"
## [1] "Subgroup" "europe"
## Warning in FUN(X[[i]], ...): less than 10 studies in group
## [1] "Subgroup" "asia"
## Warning in FUN(X[[i]], ...): less than 10 studies in group
## [1] "Subgroup" "australia"
## Warning in FUN(X[[i]], ...): less than 10 studies in group
## [1] "Subgroup" "mixed"
## Warning in FUN(X[[i]], ...): less than 10 studies in group
## [1] "Subgroup" "america"
## Warning in FUN(X[[i]], ...): less than 10 studies in group
## [1] "Network 6"
## [1] "Subgroup" "europe"
## Warning in FUN(X[[i]], ...): less than 10 studies in group
## [1] "Subgroup" "asia"
## Warning in FUN(X[[i]], ...): less than 10 studies in group
## [1] "Subgroup" "australia"
## Warning in FUN(X[[i]], ...): less than 10 studies in group
## [1] "Subgroup" "mixed"
## Warning in FUN(X[[i]], ...): less than 10 studies in group
## [1] "Subgroup" "america"
## Warning in FUN(X[[i]], ...): less than 10 studies in group
## [1] "Network 7"
## [1] "Subgroup" "europe"
## Warning in FUN(X[[i]], ...): less than 10 studies in group
## [1] "Subgroup" "asia"
## Warning in FUN(X[[i]], ...): less than 10 studies in group
## [1] "Subgroup" "australia"
## Warning in FUN(X[[i]], ...): less than 10 studies in group
## [1] "Subgroup" "mixed"
## Warning in FUN(X[[i]], ...): less than 10 studies in group
## [1] "Subgroup" "america"
## Warning in FUN(X[[i]], ...): less than 10 studies in group
report <- lapply(1:7,function(netid){
print(paste("Network ", netid, sep=""))
netReport(studyTable, SGs, netid, "mortality", subgroup="multiplediet_subg")
})
## [1] "Network 1"
## [1] "Subgroup" "no"
## [1] "Subgroup" "yes"
## Warning in FUN(X[[i]], ...): less than 10 studies in group
## [1] "Network 2"
## [1] "Subgroup" "no"
## Warning in FUN(X[[i]], ...): less than 10 studies in group
## [1] "Subgroup" "yes"
## Warning in FUN(X[[i]], ...): less than 10 studies in group
## [1] "Network 3"
## [1] "Subgroup" "no"
## Warning in FUN(X[[i]], ...): less than 10 studies in group
## [1] "Subgroup" "yes"
## Warning in FUN(X[[i]], ...): less than 10 studies in group
## [1] "Network 4"
## [1] "Subgroup" "no"
## [1] "Subgroup" "yes"
## Warning in FUN(X[[i]], ...): less than 10 studies in group
## [1] "Network 5"
## [1] "Subgroup" "no"
## Warning in FUN(X[[i]], ...): less than 10 studies in group
## [1] "Subgroup" "yes"
## Warning in FUN(X[[i]], ...): less than 10 studies in group
## [1] "Network 6"
## [1] "Subgroup" "no"
## Warning in FUN(X[[i]], ...): less than 10 studies in group
## [1] "Subgroup" "yes"
## Warning in FUN(X[[i]], ...): less than 10 studies in group
## [1] "Network 7"
## [1] "Subgroup" "no"
## Warning in FUN(X[[i]], ...): less than 10 studies in group
## [1] "Subgroup" "yes"
## Warning in FUN(X[[i]], ...): less than 10 studies in group
### Subgroup for problematic studies
report <- lapply(1:7,function(netid){
print(paste("Network ", netid, sep=""))
netReport(studyTable, SGs, netid, "mortality", subgroup="problematic_subg")
})
## [1] "Network 1"
## [1] "Subgroup" "no"
## [1] "Subgroup" "yes"
## Warning in FUN(X[[i]], ...): less than 10 studies in group
## [1] "Network 2"
## [1] "Subgroup" "no"
## [1] "Subgroup" "yes"
## Warning in FUN(X[[i]], ...): less than 10 studies in group
## [1] "Network 3"
## [1] "Subgroup" "no"
## Warning in FUN(X[[i]], ...): less than 10 studies in group
## [1] "Subgroup" "yes"
## Warning in FUN(X[[i]], ...): less than 10 studies in group
## [1] "Network 4"
## [1] "Subgroup" "no"
## [1] "Subgroup" "yes"
## Warning in FUN(X[[i]], ...): less than 10 studies in group
## [1] "Network 5"
## [1] "Subgroup" "no"
## Warning in FUN(X[[i]], ...): less than 10 studies in group
## [1] "Subgroup" "yes"
## Warning in FUN(X[[i]], ...): less than 10 studies in group
## [1] "Network 6"
## [1] "Subgroup" "no"
## Warning in FUN(X[[i]], ...): less than 10 studies in group
## [1] "Subgroup" "yes"
## Warning in FUN(X[[i]], ...): less than 10 studies in group
## [1] "Network 7"
## [1] "Subgroup" "no"
## Warning in FUN(X[[i]], ...): less than 10 studies in group
## [1] "Subgroup" "yes"
## Warning in FUN(X[[i]], ...): less than 10 studies in group
To access the network’s 2 results you just load
results/mortality/network/mortalitynet2.rds either by the
command indicated or by opening the file with rstudio
mortalityallnet2 <- readRDS("results/mortality/network/all/mortalityallnet2.rds")
Get the order of treatments
mortalityallnet2$netobj$trts
## [1] "CHO" "MUFA" "PRO" "PUFA" "SFA" "TFA"
Define a custom treatment order for the forestplot
trtsOrder <- c("PUFA","PRO", "SFA", "TFA","CHO", "MUFA" )
We have to rerun netmeta
net2 <- netmeta( TE=TE, seTE=seTE
, treat1=treat1, treat2=treat2
, studlab=studlab
, data=mortalityallnet2$netobj$data
, sm="RR"
, seq=trtsOrder
)
Get the league table
nl2 <- netleague(net2)
print(nl2$random)
## V1 V2 V3
## 1 PUFA 0.9924 [0.8631; 1.1412] 0.8604 [0.8048; 0.9198]
## 2 0.9075 [0.8187; 1.0059] PRO 0.9895 [0.8869; 1.1039]
## 3 0.8585 [0.8057; 0.9147] 0.9460 [0.8591; 1.0416] SFA
## 4 0.7503 [0.6723; 0.8374] 0.8268 [0.7212; 0.9480] 0.8741 [0.7848; 0.9735]
## 5 0.8968 [0.8426; 0.9544] 0.9882 [0.8940; 1.0923] 1.0446 [0.9861; 1.1066]
## 6 0.9410 [0.8811; 1.0050] 1.0370 [0.9361; 1.1487] 1.0962 [1.0314; 1.1650]
## V4 V5 V6
## 1 0.6372 [0.5580; 0.7276] 0.8993 [0.8414; 0.9612] 0.9195 [0.8572; 0.9863]
## 2 0.9588 [0.5484; 1.6765] 1.0136 [0.8865; 1.1589] 1.0582 [0.9166; 1.2217]
## 3 0.8526 [0.7483; 0.9713] 1.0601 [0.9962; 1.1282] 1.0943 [1.0257; 1.1675]
## 4 TFA 1.1797 [1.0546; 1.3196] 1.3518 [1.1877; 1.5387]
## 5 1.1951 [1.0769; 1.3264] CHO 1.0597 [0.9937; 1.1302]
## 6 1.2541 [1.1254; 1.3976] 1.0494 [0.9885; 1.1139] MUFA
And the forest plots will follow the order defined
forest(net2
, label.right="Network 2"
, smlab=paste("RR Mortality")
)